home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / pcgames.arc / BIO.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1982-09-27  |  4.6 KB  |  163 lines
  1. 10  'UPDATE 9/27/82
  2. 20  KEY OFF:SCREEN 0,0,0:WIDTH 80:COLOR 3,0,0
  3. 30  CLEAR 200:DEFINT K,L:DEFDBL B,J,M-Y:DEFSTR C,E,Z
  4. 40  ON KEY(1) GOSUB 1610
  5. 50  ON KEY(10) GOSUB 930
  6. 60  FOR A=2 TO 9:ON KEY(A) GOSUB 410:KEY(A) ON:NEXT
  7. 70  L=0:T=35:P=3.14159:CLS
  8. 80  GOSUB 1020:XX=1:YY=1:GOSUB 990
  9. 90  LOCATE 1,1:PRINT"KEY"STRING$(78,205)"CLOSE"
  10. 100  LOCATE 3,1:PRINT"SCREEN"STRING$(78,205)"LOAD"
  11. 110  LOCATE 2,1:PRINT"OPEN"SPC(31)"B I O R H Y T H M"SPC(30)"OPEN"
  12. 120  COLOR 0,7:LOCATE 4,25:PRINT" Please Enter Your Birth Date ":COLOR 3,0
  13. 130  LOCATE 6,30:PRINT"(m-d-y)";
  14. 140  GOSUB 390:GOSUB 420
  15. 150  JB=JD
  16. 160  GOSUB 490
  17. 170  COLOR 0,7:LOCATE 4,20:PRINT" Please Enter A Start Date For Your Chart ";
  18. 180  COLOR 3,0:LOCATE 6,30,1:PRINT"(m-d-y)";
  19. 190  GOSUB 390:GOSUB 420
  20. 200  JC=JD
  21. 210  IF JC<JB THEN GOSUB 530:GOTO 120
  22. 220  GOSUB 560
  23. 230  N=JC-JB
  24. 240  V=23:GOSUB 590
  25. 250  V=28:GOSUB 590
  26. 260  V=33:GOSUB 590
  27. 270  GOSUB 760
  28. 280  E=" "+E
  29. 290  COLOR 15,0:LOCATE ,,0:PRINT C;:COLOR 3,0:PRINT E;
  30. 300  JC=JC+1:L=L+1:IF L<21 THEN 230
  31. 310  LOCATE 24,15:COLOR 15,0:PRINT" Strike Space Bar To Continue---<F1> To Enter New Dates";
  32. 320  COLOR 3,0
  33. 330  LOCATE 25,24:COLOR 0,7:PRINT" Strike <F10> To Leave This Program ";:COLOR 3,0
  34. 340  KEY(1) ON
  35. 350  DEF SEG:POKE 106,0:IF INKEY$<>"" THEN 350
  36. 360  Z=INKEY$:IF Z="" THEN 360 ELSE IF Z=" " THEN 380
  37. 370  GOTO 360
  38. 380  KEY (1) OFF:L=0:GOTO 220
  39. 390  GOSUB 1270
  40. 400  YEAR=YEAR+1900
  41. 410  RETURN
  42. 420  W=FIX((MONTH-14)/12)
  43. 430  JD=INT(1461*(YEAR+4800+W)/4)
  44. 440  B=FIX(367*(MONTH-2-W*12)/12)
  45. 450  JD=JD+B
  46. 460  B=INT(INT(3*(YEAR+4900+W)/100)/4)
  47. 470  JD=JD+DAY-32075-B
  48. 480  RETURN
  49. 490  FOR A=6 TO 4 STEP -1
  50. 500     LOCATE A,1:PRINT SPC(79);
  51. 510  NEXT
  52. 520  RETURN
  53. 530  LOCATE 10,21:PRINT"Start Date Cannot Be Earlier Than Your
  54. 540  LOCATE 11,21:PRINT"     Birth Date. Please Try Again.
  55. 550  FOR A=1 TO 4000:NEXT:LOCATE 10,1:PRINT SPC(79):PRINT SPC(79):GOTO 490
  56. 560  CLS:COLOR 7,0:PRINT"--DATE--";SPC(13)"D O W N"SPC(12)"CRITICAL"SPC(12)"U P"
  57. 570  COLOR 2,0:PRINT SPC(8)STRING$(72,219);
  58. 580  RETURN
  59. 590  W=INT(N/V):R=N-W*V
  60. 600  IF V<>23 THEN 640
  61. 610  E=SPACE$(72)
  62. 620  E=LEFT$(E,T)+CHR$(222)+RIGHT$(E,T)
  63. 630  IF V=23 THEN C="P"
  64. 640  IF V=28 THEN C="E"
  65. 650  IF V=33 THEN C="I"
  66. 660  W=R/V:W=W*2*P
  67. 670  W=T*SIN(W):W=W+T+1.5
  68. 680  W=INT(W):Z=MID$(E,W,1)
  69. 690  IF Z="P" OR Z="E" OR Z="&" THEN C="&"
  70. 700  IF W=1 THEN 740
  71. 710  IF W=T+T+1 THEN 750
  72. 720  E=LEFT$(E,W-1)+C+RIGHT$(E,T+T+1-W)
  73. 730  RETURN
  74. 740  E=C+RIGHT$(E,T+T):RETURN
  75. 750  E=LEFT$(E,T+T)+C:RETURN
  76. 760  W=JC+68569:R=INT(4*W/146097)
  77. 770  W=W-INT((146097*R+3)/4)
  78. 780  YEAR=INT(4000*(W+1)/1.461E+06)
  79. 790  W=W-INT(1461*YEAR/4)+31
  80. 800  MONTH=INT(80*W/2447)
  81. 810  DAY=W-INT(2447*MONTH/80)
  82. 820  W=INT(MONTH/11):MONTH=MONTH+2-12*W
  83. 830  YEAR=100*(R-49)+YEAR+W
  84. 840  Z=STR$(MONTH):W=LEN(Z)-1
  85. 850  IF MONTH<10 THEN Z=" "+Z:W=W+1
  86. 860  C=MID$(Z,2,W)+"/"
  87. 870  Z=STR$(DAY):W=LEN(Z)-1
  88. 880  IF DAY<10 THEN Z="0"+Z:W=W+1
  89. 890  C=C+MID$(Z,2,W)+"/"
  90. 900  Z=STR$(YEAR):W=LEN(Z)-1
  91. 910  C=C+MID$(Z,W,2)
  92. 920  RETURN
  93. 930  XX=CSRLIN:YY=POS(0)
  94. 940  KEY(1) OFF:KEY(10) OFF:LOCATE 25,1:PRINT SPC(78);
  95. 950  COLOR 15,0:LOCATE 25,21:PRINT"Do You Wish To Leave This Program? <Y/N>";:COLOR 3,0
  96. 960  Z=INKEY$:IF Z="" THEN 960
  97. 970  IF Z="Y" OR Z="y" THEN RUN"MENU
  98. 980  IF Z<>"N" AND Z<>"n" THEN 960
  99. 990  LOCATE 25,1:PRINT SPC(78);:COLOR 0,7:LOCATE 25,23
  100. 1000  PRINT" Strike <F10> To Leave This Program ";:Z="":KEY(1) ON:KEY(10) ON:COLOR 3,0
  101. 1010  LOCATE XX,YY:RETURN
  102. 1020  'INSTRUCTIONS
  103. 1030  CLS:PRINT STRING$(80,219)
  104. 1040  FOR A=2 TO 22:LOCATE A,1:PRINT CHR$(219):LOCATE A,80:PRINT CHR$(219):NEXT
  105. 1050  LOCATE 23,1:PRINT STRING$(80,219);
  106. 1060  COLOR 15,0:LOCATE 3,32:PRINT"B I O R H Y T H M
  107. 1070  LOCATE 8,23:PRINT"Would You Like Instructions? <Y/N>":COLOR 3,0
  108. 1080  Z=INKEY$:IF Z="" THEN 1080
  109. 1090  IF Z="N" OR Z="n" THEN CLS:RETURN
  110. 1100  IF Z<>"Y" AND Z<>"y" THEN 1080
  111. 1110  COLOR 15,0:LOCATE 3,9:PRINT"             P E R S O N A L    B I O R H Y T H M ":COLOR 3,0
  112. 1120  LOCATE 5,22:PRINT"The  Biorhythm  theory was originally
  113. 1130  LOCATE 6,22:PRINT"developed in  the  19th  century.  It
  114. 1140  LOCATE 7,22:PRINT"suggests  that we  are  all  affected
  115. 1150  LOCATE 8,22:PRINT"by predictable  and recurring  cycles.
  116. 1160  LOCATE 9,22:PRINT"There  are   THREE   distinct  cycles:
  117. 1170  LOCATE 11,22:PRINT"  <1> The 23 day Physical Rhythm
  118. 1180  LOCATE 12,22:PRINT"  <2> The 28 day Emotional Rhythm
  119. 1190  LOCATE 13,22:PRINT"  <3> The 33 day Intellectual Rhythm
  120. 1200  LOCATE 15,22:PRINT"First enter your birth date, then the
  121. 1210  LOCATE 16,22:PRINT"date that you would like the chart to
  122. 1220  LOCATE 17,22:PRINT"begin.
  123. 1230  LOCATE 19,22:PRINT"For more information on the Biorhythm
  124. 1240  LOCATE 20,22:PRINT"Theory, see page  31  in your manual.
  125. 1250  LOCATE 25,27:COLOR 14,0:PRINT"Strike Any Key To Continue";:COLOR 3,0
  126. 1260  Z=INKEY$:IF Z="" THEN 1260 ELSE CLS:RETURN
  127. 1270  LOCATE ,40:PRINT SPC(39);:LOCATE ,40,1:
  128. 1280  Z1="":Z=""
  129. 1290  Z=INKEY$:IF Z="" THEN 1290
  130. 1300  IF Z="." OR Z="/" OR Z="-" OR Z=" " THEN 1360
  131. 1310  IF Z=CHR$(8) OR RIGHT$(Z,1)=CHR$(75) THEN Z1="":Z="":GOTO 1270
  132. 1320  IF Z=CHR$(13) OR LEN(Z)>1 THEN 1290
  133. 1330  IF LEN(Z1)>1 THEN 1290
  134. 1340  IF Z<"0" OR Z>"9" THEN 1290
  135. 1350  Z1=Z1+Z:LOCATE ,40:PRINT Z1;:GOTO 1290
  136. 1360  MONTH=VAL(Z1):IF MONTH<1 OR MONTH >12 THEN 1270
  137. 1370  Z2=Z1+Z:LOCATE ,40:PRINT Z2;:Z1="":Z=""
  138. 1380  Z=INKEY$:IF Z="" THEN 1380
  139. 1390  IF Z="." OR Z="/" OR Z="-" OR Z=" " THEN 1460
  140. 1400  IF Z=CHR$(13) THEN 1380
  141. 1410  IF Z=CHR$(8) OR RIGHT$(Z,1)=CHR$(75) THEN Z1="":Z="":GOTO 1270
  142. 1420  IF LEN(Z1)>1 THEN 1290
  143. 1430  IF LEN(Z)>1 THEN 1380
  144. 1440  IF Z<"0" OR Z>"9" THEN 1380
  145. 1450  Z1=Z1+Z:LOCATE ,POS(0):PRINT Z;:GOTO 1380
  146. 1460  DAY=VAL(Z1):IF DAY<1 OR DAY>31 THEN 1270
  147. 1470  Z2=Z2+Z1+Z:LOCATE ,40:PRINT Z2;:Z1="":Z=""
  148. 1480  Z=INKEY$:IF Z="" THEN 1480
  149. 1490  IF Z="." OR Z="/" OR Z="-" OR Z=" " THEN 1540
  150. 1500  IF Z=CHR$(8) OR RIGHT$(Z,1)=CHR$(75) THEN Z1="":Z="":GOTO 1270
  151. 1510  IF Z=CHR$(13) OR LEN(Z)>1 THEN 1480
  152. 1520  IF Z<"0" OR Z>"9" THEN 1480
  153. 1530  Z1=Z1+Z:LOCATE ,POS(0):PRINT Z;:IF LEN(Z1)<2 THEN 1480
  154. 1540  YEAR=VAL(Z1)
  155. 1550  Z2=Z2+Z1
  156. 1560  LOCATE ,POS(0)+5,1:COLOR 15,0:PRINT"Correct? <Y/N>";:COLOR 3,0
  157. 1570  Z=INKEY$:IF Z="" THEN 1570
  158. 1580  IF Z="y" OR Z="Y" THEN RETURN
  159. 1590  IF Z<>"n" AND Z<>"N" THEN 1570
  160. 1600  GOTO 1270
  161. 1610  RETURN 1620
  162. 1620  L=0:CLS:KEY(1) OFF:GOTO 90
  163.